home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / hearts / leafpol9.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-04-16  |  9.9 KB  |  280 lines
  1. VERSION 5.00
  2. Begin VB.Form LeafPol8 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    BorderStyle     =   0  'None
  6.    Caption         =   "Leafpol8 Prg"
  7.    ClientHeight    =   2400
  8.    ClientLeft      =   1065
  9.    ClientTop       =   1515
  10.    ClientWidth     =   3000
  11.    BeginProperty Font 
  12.       Name            =   "MS Sans Serif"
  13.       Size            =   8.25
  14.       Charset         =   0
  15.       Weight          =   700
  16.       Underline       =   0   'False
  17.       Italic          =   0   'False
  18.       Strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H80000008&
  21.    KeyPreview      =   -1  'True
  22.    LinkTopic       =   "Form1"
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    PaletteMode     =   1  'UseZOrder
  26.    ScaleHeight     =   2400
  27.    ScaleWidth      =   3000
  28.    ShowInTaskbar   =   0   'False
  29.    WindowState     =   2  'Maximized
  30. Attribute VB_Name = "LeafPol8"
  31. Attribute VB_GlobalNameSpace = False
  32. Attribute VB_Creatable = False
  33. Attribute VB_PredeclaredId = True
  34. Attribute VB_Exposed = False
  35.      
  36. Private Declare Function ShowCursor& Lib "user32" (ByVal bShow&)    'as Byte
  37. Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  38. Private Sub flower()
  39. pi = 4 * Atn(1)
  40.  f1x = stx: f1y = sty                      'Take TOP of STEM X,Y
  41.   FillColor = QBColor(Int(Rnd * 15) + 1) 'Color of 6 Petals
  42.   a = 8                                           ' Diam of Ring
  43. For s = 3 To 9 Step 3
  44.  For t = 0 To pi Step 0.52              '6 Petals
  45.    d = a * Cos(t)                              'D=Diameter of Ring of Petals
  46.    f2x = d * Cos(t): f2y = d * Sin(t)
  47.    DrawWidth = 1
  48.    Circle (f1x + f2x - 6, f1y + f2y), 9, QBColor(Int(Rnd * 15))
  49.    DrawStyle = 2
  50.    Circle (f1x + f2x - 6, f1y + f2y), 9
  51.    DoEvents
  52.    TimeOut
  53.    DoEvents
  54.  Next t
  55.  DoEvents
  56.   a = a + 9
  57. Next s
  58.  FillStyle = 0                     'For next Screen
  59.  FillColor = QBColor(Int(Rnd * 15))
  60.  Circle (f1x + 8, f1y), 7, QBColor(Int(Rnd * 15))
  61. End Sub
  62. Private Sub leafpol8_KeyPress(KeyAscii As Integer)
  63.      ExitClean
  64. End Sub
  65. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  66.      ExitClean
  67. End Sub
  68. Private Sub Form_Load()
  69. If App.PrevInstance Then
  70.     Unload Me
  71.     Exit Sub
  72. End If
  73. End Sub
  74. Private Sub heart()                   '------        THE   BIG   HEART       ------------
  75. FillColor = QBColor(15)            ' Clear Big Circle
  76. DrawStyle = 0                          'Quick exiting if and when this is made
  77.     Circle (0, 0), 138                  'into a Screen Saver
  78. WaitABit
  79.      pi = 22 / 7
  80.      DrawWidth = 3: DrawStyle = 0
  81.      a = 100: b = 100                                 'Q=Theta Angle  'HEART
  82.      a1 = 102: b1 = 102
  83. For q = -pi / 2 To 0 Step 0.01                  'Polar graph needs Pi iterations.
  84.     Y = a * Cos(q * 2) * Sqr(Abs(Sin(q)))    'here we use part of Polar Spiral
  85.     X = b * Sin(q * 2) * Sqr(Abs(Cos(q)))    'to make half a heart & mirror img.
  86.     Line (0, 0)-(X, Y), QBColor(12)
  87.     DoEvents
  88.     Line (0, 0)-(-X, Y), QBColor(12)
  89.     DoEvents                                            'for Mouse Move exit
  90. Next q
  91.    DoEvents                                              'Posy Start - On Heart
  92.    TimeOut
  93.    DrawStyle = 2: DrawWidth = 1: FillStyle = 0
  94.    FillColor = QBColor(Int(Rnd * 15) + 1)  'Color of 6 Petals
  95.    TimeOut
  96.    TimeOut
  97.    TimeOut
  98.    a = 25                                                           'Diam of Ring of petals.
  99.  For t = 0 To pi Step 0.52 ' pi / 6                      '6 Petals
  100.    d = a * Cos(t)
  101.    X = d * Cos(t): Y = d * Sin(t)
  102.    Circle (X - 12, Y + 32), 12, QBColor(Int(Rnd * 15))
  103.  Next t
  104.  DoEvents
  105.    DrawStyle = 2
  106.    FillColor = QBColor(Int(Rnd * 15))
  107.    Circle (X - 25, Y + 32), 7, QBColor(Int(Rnd * 15)) 'Seed Pod?
  108.  '----------- End of <Flower-in-Heart>
  109. TimeOut
  110. TimeOut
  111. TimeOut
  112. TimeOut
  113. TimeOut
  114.   DoEvents
  115. End Sub
  116. Private Sub leafpol8_Click(Click As Integer)
  117.        ExitClean
  118. End Sub
  119.   Private Sub ring()
  120. '========         -- Big Ring
  121. ForeColor = QBColor(12)
  122. pi = 4 * Atn(1)
  123. FillStyle = 0
  124.    ctr = 0: c = 0
  125.    a = 120               'Radius't = -pi
  126.    X = a * Cos(t)      '\ Set
  127.    Y = a * Sin(t)       ' >First
  128.    PSet (X, Y)  '/ Point
  129.    ' --1st Loop  just fills Array.  2nd makes wreath. -------
  130. For t = -pi To pi Step 2 * pi / 32    'Big Pol Circ
  131.     ctr = ctr + 1
  132.     X = a * Cos(t)                      'Convert . .
  133.     Y = a * Sin(t)                       'to Cartesian
  134.     wx(ctr) = X: wy(ctr) = Y       'Fill Wreath Array <wx(),wy()> are SPOTS
  135. Next t                                     ' Spot Centers wx(),wy()
  136.     DoEvents
  137.    '---------------- Make small hearts here---------------@ spots.
  138.     DrawWidth = 3: DrawStyle = 0
  139.     a = 15                                         'Small Hearts
  140. For c = 1 To 32 Step 2
  141.     DoEvents
  142.     DrawWidth = 2
  143.         For q = -pi / 2 To 0 Step 0.05                                '  Small Hearts
  144.             Y = a * Cos(q * 2) * Sqr(Abs(Sin(q)))                  'here we use part of Polar Spiral
  145.             X = a * Sin(q * 2) * Sqr(Abs(Cos(q)))                  'to make half a heart & mirror img.
  146.             Line (wx(c), wy(c))-(X + wx(c), Y + wy(c))   'Small Heart-Right Half
  147.                DoEvents
  148.             Line (wx(c), wy(c))-(-X + wx(c), Y + wy(c))  'Left Half
  149.                DoEvents
  150.         Next q                       'Ring of Small Hearts Done------
  151.         TimeOut
  152.      c = c + 2                       'Next:- Small  FLOWER  Every other "Spot"-
  153.      FillColor = QBColor(Int(Rnd * 15) + 1)      'Color of 6 Petals
  154.         a = 15                                                            ' Diam of petal centers
  155.     DrawStyle = 2
  156.         For t = 0 To pi Step 0.52                                '6 Petals
  157.           d = a * Cos(t)                                                'D=
  158.           fX = d * Cos(t): fY = d * Sin(t)
  159.           DrawWidth = 1
  160.           Circle (fX + wx(c) - 6, fY + wy(c)), 7, QBColor(Int(Rnd * 15))      'Petal
  161.           TimeOut
  162.                  DoEvents
  163.         Next t
  164.         FillStyle = 0
  165.         FillColor = QBColor(Int(Rnd * 15))
  166.         Circle (wx(c), wy(c)), 4, QBColor(Int(Rnd * 15))   'Seed Pod?
  167.         TimeOut
  168.  Next c
  169. '-----------------   Flower every other one.
  170. z = 0: c = 0
  171. DoEvents
  172. Pause
  173. End Sub
  174. '                ---------              Exit on Mouse Move            -----------
  175. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  176. If IsEmpty(mousex) Or IsEmpty(mousey) Or IsNull(mousex) Or IsNull(mousey) Then
  177.         mousex = X:   mousey = Y
  178.         Exit Sub
  179.     End If
  180.    If Abs(mousex - X) > 2 Or Abs(mousey - Y) > 2 Then
  181.             mousex = X:  mousey = Y
  182.            ExitClean
  183.     End If
  184. End Sub
  185. Public Sub ExitClean()
  186.  Dim filename As String
  187.     Dim rc As Long
  188.               
  189.     bShow& = ShowCursor(True)          'Via API Function(bShow&) call
  190.         Unload Me                                  'See Declares over Form Code
  191.     End
  192. End Sub
  193. Public Sub TimeOut()
  194. t = 0
  195. Interval = 0.025
  196. t = Timer + Interval                            'Seconds
  197.        While Timer < t
  198.        Wend
  199. End Sub
  200. Public Sub Pause()
  201. t = 0
  202. t = Timer + 5
  203.     While Timer < t
  204.     DoEvents
  205.     Wend
  206. End Sub
  207. Public Sub WaitABit()
  208.  t = 0
  209. t = Timer + 2
  210.     While Timer < t
  211.     DoEvents
  212.     Wend
  213. End Sub
  214. Public Sub begin()
  215. bShow& = ShowCursor(False)       'HIDE Mouse via API Function
  216. Randomize                            '========================
  217. Dim pi As Single
  218. pi = 4 * Atn(1)
  219.    a = 20                 'Radius for STEM & LEAVES
  220.    X = a * Cos(t)      ' \ Set
  221.    Y = a * Sin(t)       ' >First
  222.    PSet (X, Y)  '/ Point
  223. Do While DoEvents()
  224. BackColor = QBColor(Int(Rnd * 16))
  225.    ' --1st Loop Round Polar Circ    -     For  RING around Heart
  226. ctr = 0: a = 20
  227. For t = pi To (-pi) - pi / 3 Step -2 * pi / 30   'Big Pol Circ
  228.  ctr = ctr + 1                     'Count Points
  229.    X = a * Cos(t)                'Convert . .
  230.    Y = a * Sin(t)                 'to Cartesian
  231.    px(ctr) = X: py(ctr) = Y   'Fill array of Points round Pol Circ
  232.    sx(ctr) = 0: sy(ctr) = 0    'Array Start of Stem.
  233.    DoEvents
  234. Next t
  235.  '====================   'Plant with Leaves  and Flowers  ====
  236. For stems = 1 To 50           'Number of whole plants
  237.  '====================================================
  238.  DoEvents
  239.   c = 8                                          'Angle    <<Vertical>>
  240.   stx = Int(Rnd * 560) - 280         ' Set Start of STEM
  241.   sty = Int(Rnd * 350) - 260
  242.  For ctr = 1 To 7                           'Number of branches <0--0> & Leaves
  243.    DrawStyle = 0
  244.    ForeColor = QBColor(6)   'Stem and Leaf Circle
  245.    FillColor = QBColor(2)      'Leaf
  246.    FillStyle = 0
  247.    c = c + Int(Rnd * 11) - 5            'C picks Angle from Array made above
  248.    If c > 33 Then
  249.      c = c - 6                                  'Avoid 0-3 & over 33
  250.    End If
  251.    If c < 3 Then
  252.      c = c + 7
  253.    End If
  254.    Line (stx + sx(c), sty + sy(c))-(stx + px(c), sty + py(c))         'Stem(Start-End)
  255.    Line (stx + px(c - 2), sty + py(c - 2))-(stx + px(c + 2), sty + py(c + 2)) 'Join Leaves
  256.  TimeOut                               '============================
  257.    DrawStyle = 2
  258.    Circle (stx + px(c - 2), sty + py(c - 2)), 6         'Draw leaves
  259.    Circle (stx + px(c + 2), sty + py(c + 2)), 6
  260.     TimeOut
  261.    DrawStyle = 0
  262.    stx = stx + px(c)         'Next Stem Start=Last Stem End
  263.    sty = sty + py(c)
  264.   Next ctr
  265.   DoEvents
  266.   TimeOut                       '===============================
  267.      Call flower                 'This Flower appears at each stem end
  268. Next stems
  269.         DoEvents
  270.         Call heart                'Big Heart, in white Circle
  271.  DoEvents
  272.         Call ring                  'Ring of "HEARTS & FLOWERS" the Finale
  273.  DoEvents
  274. Loop                               'This type of heart is 'ORIGINAL'
  275. DoEvents
  276. End Sub
  277. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  278.      ExitClean
  279. End Sub
  280.